home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1995 February: Tool Chest / Dev.CD Feb 95 / Dev.CD Feb 95.toast / Tool Chest / Development Tools & Languages / Dylan Related / Mindy-1.1 (sources only) / mindy-1.1 / interp / vec.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-08-18  |  8.2 KB  |  330 lines  |  [TEXT/ttxt]
  1. /**********************************************************************\
  2. *
  3. *  Copyright (c) 1994  Carnegie Mellon University
  4. *  All rights reserved.
  5. *  
  6. *  Use and copying of this software and preparation of derivative
  7. *  works based on this software are permitted, including commercial
  8. *  use, provided that the following conditions are observed:
  9. *  
  10. *  1. This copyright notice must be retained in full on any copies
  11. *     and on appropriate parts of any derivative works.
  12. *  2. Documentation (paper or online) accompanying any system that
  13. *     incorporates this software, or any part of it, must acknowledge
  14. *     the contribution of the Gwydion Project at Carnegie Mellon
  15. *     University.
  16. *  
  17. *  This software is made available "as is".  Neither the authors nor
  18. *  Carnegie Mellon University make any warranty about the software,
  19. *  its performance, or its conformity to any specification.
  20. *  
  21. *  Bug reports, questions, comments, and suggestions should be sent by
  22. *  E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  23. *
  24. ***********************************************************************
  25. *
  26. * $Header: vec.c,v 1.9 94/07/26 18:34:21 hallgren Exp $
  27. *
  28. * This file implements vectors.
  29. *
  30. \**********************************************************************/
  31.  
  32. #include <stdio.h>
  33. #include <string.h>
  34. #ifdef sparc
  35. #include <memory.h>
  36. #endif
  37.  
  38. #include "mindy.h"
  39. #include "gc.h"
  40. #include "coll.h"
  41. #include "class.h"
  42. #include "thread.h"
  43. #include "func.h"
  44. #include "bool.h"
  45. #include "list.h"
  46. #include "num.h"
  47. #include "obj.h"
  48. #include "module.h"
  49. #include "sym.h"
  50. #include "type.h"
  51. #include "error.h"
  52. #include "print.h"
  53. #include "def.h"
  54. #include "vec.h"
  55.  
  56.  
  57. /* Simple object vectors. */
  58.  
  59. obj_t obj_SimpleObjectVectorClass = NULL;
  60.  
  61. obj_t make_vector(int length, obj_t *contents)
  62. {
  63.     obj_t res = alloc(obj_SimpleObjectVectorClass,
  64.               sizeof(struct sovec) + sizeof(obj_t)*length);
  65.  
  66.     SOVEC(res)->length = length;
  67.  
  68.     if (contents)
  69.     memcpy(SOVEC(res)->contents, contents,
  70.            sizeof(obj_t) * length);
  71.  
  72.     return res;
  73. }
  74.  
  75. static void dylan_vector(struct thread *thread, int nargs)
  76. {
  77.     obj_t *args = thread->sp - nargs;
  78.     obj_t res = make_vector(nargs, args);
  79.     obj_t *old_sp = args-1;
  80.  
  81.     *old_sp = res;
  82.     thread->sp = args;
  83.     do_return(thread, old_sp, old_sp);
  84. }
  85.  
  86. static obj_t dylan_sovec_element(obj_t sovec, obj_t index, obj_t def)
  87. {
  88.     int i = fixnum_value(index);
  89.  
  90.     if (0 <= i && i < SOVEC(sovec)->length)
  91.     return SOVEC(sovec)->contents[i];
  92.     else if (def != obj_Unbound)
  93.     return def;
  94.     else {
  95.     error("No element %= in %=", index, sovec);
  96.     return NULL;
  97.     }
  98. }
  99.  
  100. static obj_t dylan_sovec_element_setter(obj_t value, obj_t sovec, obj_t index)
  101. {
  102.     int i = fixnum_value(index);
  103.  
  104.     if (0 <= i && i < SOVEC(sovec)->length)
  105.     SOVEC(sovec)->contents[i] = value;
  106.     else
  107.     error("No element %= in %=", index, sovec);
  108.  
  109.     return value;
  110. }
  111.  
  112. static obj_t dylan_sovec_size(obj_t sovec)
  113. {
  114.     return make_fixnum(SOVEC(sovec)->length);
  115. }
  116.  
  117. static obj_t dylan_vec_make(obj_t class, obj_t size, obj_t fill)
  118. {
  119.     obj_t res;
  120.     int len;
  121.     obj_t *ptr;
  122.  
  123.     if (!instancep(size, obj_IntegerClass))
  124.     error("Bogus size: for make %=: %=", class, size);
  125.     len = fixnum_value(size);
  126.  
  127.     if (len < 0)
  128.     error("Bogus size: for make %=: %=", class, size);
  129.  
  130.     res = make_vector(len, NULL);
  131.  
  132.     ptr = SOVEC(res)->contents;
  133.     while (len-- > 0)
  134.     *ptr++ = fill;
  135.  
  136.     return res;
  137. }
  138.  
  139.  
  140. /* Byte Vector support. */
  141.  
  142. obj_t obj_ByteVectorClass = NULL;
  143.  
  144. obj_t make_byte_vector(int length, unsigned char *contents)
  145. {
  146.     obj_t res = alloc(obj_ByteVectorClass,
  147.               sizeof(struct sovec) + length);
  148.  
  149.     BYTEVEC(res)->length = length;
  150.  
  151.     if (contents)
  152.     memcpy(BYTEVEC(res)->contents, contents, length);
  153.  
  154.     return res;
  155. }
  156.  
  157. static obj_t dylan_bytevec_element(obj_t bytevec, obj_t index, obj_t def)
  158. {
  159.     int i = fixnum_value(index);
  160.  
  161.     if (0 <= i && i < BYTEVEC(bytevec)->length)
  162.     return make_fixnum(BYTEVEC(bytevec)->contents[i]);
  163.     else if (def != obj_Unbound)
  164.     return def;
  165.     else {
  166.     error("No element %= in %=", index, bytevec);
  167.     return NULL;
  168.     }
  169. }
  170.  
  171. static obj_t dylan_bytevec_element_setter(obj_t value, obj_t bytevec,
  172.                       obj_t index)
  173. {
  174.     int i = fixnum_value(index);
  175.  
  176.     if (0 <= i && i < BYTEVEC(bytevec)->length)
  177.     BYTEVEC(bytevec)->contents[i] = fixnum_value(value);
  178.     else
  179.     error("No element %= in %=", index, bytevec);
  180.  
  181.     return value;
  182. }
  183.  
  184. static obj_t dylan_bytevec_size(obj_t bytevec)
  185. {
  186.     return make_fixnum(BYTEVEC(bytevec)->length);
  187. }
  188.  
  189. static obj_t dylan_byte_vec_make(obj_t class, obj_t size, obj_t fill)
  190. {
  191.     obj_t res;
  192.     int len;
  193.  
  194.     if (!obj_is_fixnum(size) || fixnum_value(size) < 0)
  195.     error("Bogus size: for make %=: %=", class, size);
  196.     len = fixnum_value(size);
  197.  
  198.     if (!obj_is_fixnum(fill) || fixnum_value(fill) < 0
  199.       || fixnum_value(fill) > 255)
  200.     error("Bogus fill: for make %=: %=", class, fill);
  201.  
  202.     res = make_byte_vector(len, NULL);
  203.  
  204.     memset(BYTEVEC(res)->contents, fixnum_value(fill), len);
  205.  
  206.     return res;
  207. }
  208.  
  209.  
  210.  
  211. /* Printing support. */
  212.  
  213. static void print_sovec(obj_t sovec)
  214. {
  215.     int len = SOVEC(sovec)->length;
  216.     int i;
  217.  
  218.     printf("#[");
  219.     for (i = 0; i < len; i++) {
  220.     if (i)
  221.         printf(", ");
  222.     prin1(SOVEC(sovec)->contents[i]);
  223.     }
  224.     printf("]");
  225. }
  226.  
  227.  
  228. /* GC stuff. */
  229.  
  230. static int scav_sovec(struct object *ptr)
  231. {
  232.     struct sovec *v = (struct sovec *)ptr;
  233.     int len = v->length;
  234.     int i;
  235.     
  236.     for (i = 0; i < len; i++)
  237.     scavenge(v->contents + i);
  238.  
  239.     return sizeof(struct sovec) + sizeof(obj_t)*len;
  240. }
  241.  
  242. static obj_t trans_sovec(obj_t v)
  243. {
  244.     int len = SOVEC(v)->length;
  245.     return transport(v, sizeof(struct sovec) + sizeof(obj_t)*len);
  246. }
  247.  
  248. static int scav_bytevec(struct object *ptr)
  249. {
  250.     struct bytevec *v = (struct bytevec *)ptr;
  251.     
  252.     return sizeof(struct bytevec) + v->length;
  253. }
  254.  
  255. static obj_t trans_bytevec(obj_t v)
  256. {
  257.     return transport(v, sizeof(struct bytevec) + BYTEVEC(v)->length);
  258. }
  259.  
  260. void scavenge_vec_roots(void)
  261. {
  262.     scavenge(&obj_SimpleObjectVectorClass);
  263.     scavenge(&obj_ByteVectorClass);
  264. }
  265.  
  266.  
  267.  
  268. /* Initialization stuff. */
  269.  
  270. void make_vec_classes(void)
  271. {
  272.     obj_SimpleObjectVectorClass = make_builtin_class(scav_sovec, trans_sovec);
  273.     obj_ByteVectorClass = make_builtin_class(scav_bytevec, trans_bytevec);
  274. }
  275.  
  276. void init_vec_classes(void)
  277. {
  278.     init_builtin_class(obj_SimpleObjectVectorClass, "<simple-object-vector>",
  279.                obj_VectorClass, NULL);
  280.     def_printer(obj_SimpleObjectVectorClass, print_sovec);
  281.     init_builtin_class(obj_ByteVectorClass, "<byte-vector>",
  282.                obj_VectorClass, NULL);
  283. }
  284.  
  285. void init_vec_functions(void)
  286. {
  287.     define_constant("vector",
  288.             make_raw_function("vector", 0, TRUE, obj_False, FALSE,
  289.                       list1(obj_SimpleObjectVectorClass),
  290.                       obj_False, dylan_vector));
  291.     define_method("element",
  292.             list2(obj_SimpleObjectVectorClass, obj_IntegerClass),
  293.             FALSE, list1(pair(symbol("default"), obj_Unbound)), FALSE,
  294.             obj_ObjectClass, dylan_sovec_element);
  295.     define_method("element-setter",
  296.           list3(obj_ObjectClass,
  297.             obj_SimpleObjectVectorClass,
  298.             obj_IntegerClass),
  299.           FALSE, obj_False, FALSE,
  300.           obj_ObjectClass, dylan_sovec_element_setter);
  301.     define_method("size", list1(obj_SimpleObjectVectorClass),
  302.           FALSE, obj_False, FALSE, obj_IntegerClass, dylan_sovec_size);
  303.     define_method("make", list1(singleton(obj_VectorClass)), FALSE,
  304.           list2(pair(symbol("size"), make_fixnum(0)),
  305.             pair(symbol("fill"), obj_False)),
  306.           FALSE, obj_SimpleObjectVectorClass, dylan_vec_make);
  307.     define_method("make", list1(singleton(obj_SimpleObjectVectorClass)), FALSE,
  308.           list2(pair(symbol("size"), make_fixnum(0)),
  309.             pair(symbol("fill"), obj_False)),
  310.           FALSE, obj_SimpleObjectVectorClass, dylan_vec_make);
  311.  
  312.     define_method("element",
  313.           list2(obj_ByteVectorClass, obj_IntegerClass),
  314.           FALSE, list1(pair(symbol("default"), obj_Unbound)),
  315.           FALSE, obj_IntegerClass, dylan_bytevec_element);
  316.     define_method("element-setter",
  317.           list3(obj_IntegerClass,
  318.             obj_ByteVectorClass,
  319.             obj_IntegerClass),
  320.           FALSE, obj_False, FALSE,
  321.           obj_IntegerClass, dylan_bytevec_element_setter);
  322.     define_method("size", list1(obj_ByteVectorClass),
  323.           FALSE, obj_False, FALSE,
  324.           obj_IntegerClass, dylan_bytevec_size);
  325.     define_method("make", list1(singleton(obj_ByteVectorClass)), FALSE,
  326.           list2(pair(symbol("size"), make_fixnum(0)),
  327.             pair(symbol("fill"), make_fixnum(0))),
  328.           FALSE, obj_ByteVectorClass, dylan_byte_vec_make);
  329. }
  330.